home *** CD-ROM | disk | FTP | other *** search
/ PCGUIA 127 / PC Guia 127.iso / Software / Produtividade / OpenOffice.org 2.0.1 / openofficeorg1.cab / Internet.xba < prev    next >
Extensible Markup Language  |  2005-03-24  |  11KB  |  339 lines
  1. <?xml version="1.0" encoding="UTF-8"?>
  2. <!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
  3. <script:module xmlns:script="http://openoffice.org/2000/script" script:name="Internet" script:language="StarBasic">REM  *****  BASIC  *****
  4. Option Explicit
  5. Public sNewSheetName as String
  6.  
  7. Function CheckHistoryControls()
  8. Dim bLocGoOn as Boolean
  9. Dim Firstdate as Date
  10. Dim LastDate as Date
  11.     LastDate = CDateFromISO(StockRatesModel.txtEndDate.Date)
  12.     FirstDate = CDateFromISO(StockRatesModel.txtStartDate.Date)
  13.     bLocGoOn = FirstDate <> 0 And LastDate <> 0
  14.     If bLocGoOn Then
  15.         If FirstDate >= LastDate Then
  16.             Msgbox(sMsgStartDatebeforeEndDate,16, sProductname)
  17.             bLocGoOn = False
  18.         End If
  19.     End If
  20.     CheckHistoryControls = bLocGoon
  21. End Function
  22.  
  23.  
  24. Sub InsertCompanyHistory()
  25. Dim StockName as String
  26. Dim CurRow as Integer
  27. Dim sMsgInternetError as String
  28. Dim CurRate as Double
  29. Dim oCell as Object
  30. Dim sStockID as String
  31. Dim ChartSource as String    
  32.     If CheckHistoryControls() Then
  33.         StartDate = CDateFromISO(StockRatesModel.txtStartDate.Date)
  34.         EndDate = CDateFromISO(StockRatesModel.txtEndDate.Date)
  35.         DlgStockRates.EndExecute()
  36.         If StockRatesModel.optDaily.State = 1 Then
  37.             sInterval = "d"
  38.             iStep = 1
  39.         ElseIf StockRatesModel.optWeekly.State = 1 Then
  40.             sInterval = "w"
  41.             iStep = 7
  42.             StartDate = StartDate - WeekDay(StartDate) + 2
  43.             EndDate = EndDate - WeekDay(EndDate) + 2
  44.         End If
  45.         iEndDay = Day(EndDate)
  46.         iEndMonth = Month(EndDate)
  47.         iEndYear = Year(EndDate)
  48.         iStartDay = Day(StartDate)
  49.         iStartMonth = Month(StartDate)
  50.         iStartYear = Year(StartDate)
  51. '        oDocument.AddActionLock()
  52.         UnprotectSheets(oSheets)
  53.         InitializeStatusline("", 10, 1)
  54.         oBackGroundSheet = oSheets.GetbyName("Background")    
  55.         StockName = DlgStockRates.GetControl("lstStockNames").GetSelectedItem()
  56.         CurRow = GetStockRowIndex(Stockname)
  57.         sStockID = oFirstSheet.GetCellByPosition(SBCOLUMNID1, CurRow).String
  58.         ChartSource = ReplaceString(HistoryChartSource, sStockID, "<StockID>")
  59.         ChartSource = ReplaceString(ChartSource, iStartDay, "<StartDay>")
  60.         ChartSource = ReplaceString(ChartSource, cStr(iStartMonth-1), "<StartMonth>")
  61.         ChartSource = ReplaceString(ChartSource, iStartYear, "<StartYear>")    
  62.         ChartSource = ReplaceString(ChartSource, iEndDay, "<EndDay>")
  63.         ChartSource = ReplaceString(ChartSource, cStr(iEndMonth-1), "<EndMonth>")
  64.         ChartSource = ReplaceString(ChartSource, iEndYear, "<EndYear>")
  65.         ChartSource = ReplaceString(ChartSource, sInterval, "<interval>")
  66.         oStatusLine.SetValue(2)
  67.         If GetCurrentRate(ChartSource, CurRate, 1) Then
  68.             oStatusLine.SetValue(8)
  69.             UpdateValue(StockName, Today, CurRate)
  70.             oStatusLine.SetValue(9)
  71.             UpdateChart(StockName)
  72.             oStatusLine.SetValue(10)
  73.         Else
  74.             sMsgInternetError = Stockname & ": " & sNoInternetDataAvailable & chr(13) & sCheckInternetSettings
  75.             Msgbox(sMsgInternetError, 16, sProductname)
  76.         End If
  77.         ProtectSheets(oSheets)
  78.         oStatusLine.End
  79.         If oSheets.HasbyName(sNewSheetName) Then
  80.             oController.ActiveSheet = oSheets.GetByName(sNewSheetName)
  81.         End If
  82. '        oDocument.RemoveActionLock()    
  83.     End If
  84. End Sub
  85.  
  86.  
  87.  
  88. Sub InternetUpdate()
  89. Dim i as Integer
  90. Dim StocksCount as Integer
  91. Dim iStartRow as Integer
  92. Dim sUrl as String
  93. Dim StockName as String        
  94. Dim CurRate as Double
  95. Dim oCell as Object
  96. Dim sMsgInternetError as String
  97. Dim sStockID as String
  98. Dim ChartSource as String
  99. '    oDocument.AddActionLock()
  100.     Initialize(True)
  101.     UnprotectSheets(oSheets)
  102.     StocksCount = GetStocksCount(iStartRow)
  103.     InitializeStatusline("", StocksCount + 1, 1)
  104.     Today = CDate(Date)
  105.     For i = iStartRow + 1 To iStartRow + StocksCount
  106.         StockName = oFirstSheet.GetCellbyPosition(SBCOLUMNNAME1, i).String
  107.         sStockID = oFirstSheet.GetCellByPosition(SBCOLUMNID1, i).String
  108.         ChartSource = ReplaceString(sCurChartSource, sStockID, "<StockID>")
  109.         If GetCurrentRate(ChartSource, CurRate, 0) Then
  110.             InsertCurrentValue(CurRate, i, Now)        
  111.         Else
  112.             sMsgInternetError = Stockname & ": " & sNoInternetDataAvailable & chr(13) & sCheckInternetSettings
  113.             Msgbox(sMsgInternetError, 16, sProductname)
  114.         End If
  115.         oStatusline.SetValue(i - iStartRow + 1)
  116.     Next
  117.     ProtectSheets(oSheets)
  118.     oStatusLine.End
  119. '    oDocument.RemoveActionLock
  120. End Sub
  121.  
  122.  
  123.  
  124. Function GetCurrentRate(sUrl as String, fValue As Double, iValueRow as Integer) as Boolean
  125. Dim sFilter As String
  126. Dim sOptions As String
  127. Dim oLinkSheet As Object
  128. Dim sDate as String
  129.     If oSheets.hasByName("Link") Then 
  130.         oLinkSheet = oSheets.getByName("Link")
  131.     Else
  132.         oLinkSheet = oDocument.createInstance("com.sun.star.sheet.Spreadsheet")
  133.         oSheets.insertByName("Link", oLinkSheet)
  134.         oLinkSheet.IsVisible = False
  135.     End If
  136.     
  137.     sFilter = "Text - txt - csv (StarCalc)"
  138.     sOptions = sCurSeparator & ",34,SYSTEM,1,1/10/2/10/3/10/4/10/5/10/6/10/7/10/8/10/9/10"
  139.     
  140.     oLinkSheet.LinkMode = com.sun.star.sheet.SheetLinkMode.NONE
  141.     oLinkSheet.link(sUrl, "", sFilter, sOptions, 1 )
  142.     fValue = oLinkSheet.getCellByPosition(iValueCol, iValueRow).Value
  143.     If fValue = 0 Then
  144.         Dim sValue as String
  145.         sValue = oLinkSheet.getCellByPosition(1, iValueRow).String
  146.         sValue = ReplaceString(sValue, ".",",")
  147.         fValue = Val(sValue)
  148.     End If
  149.     GetCurrentRate = fValue <> 0
  150. End Function
  151.  
  152.  
  153.  
  154. Sub UpdateValue(ByVal sName As String, fDate As Double, fValue As Double )
  155. Dim oSheet As Object
  156. Dim iColumn As Long
  157. Dim iRow As Long
  158. Dim i as Integer
  159. Dim oCell As Object
  160. Dim LastDate as Date
  161. Dim bLeaveLoop as Boolean
  162. Dim RemoveCount as Integer
  163. Dim iLastRow as Integer
  164. Dim iLastLinkRow as Integer
  165. Dim dDate as Date
  166. Dim CurDate as Date
  167. Dim oLinkSheet as Object
  168. Dim StartIndex as Integer
  169. Dim iCellValue as Long
  170.     ' Insert Sheet with Company - Chart
  171.     sName = CheckNewSheetname(oSheets, sName)
  172.     If NOT oSheets.hasByName(sName) Then
  173.         oSheets.CopybyName("Background", sName, oSheets.Count)
  174.         oSheet = oSheets.getByName(sName)
  175.         iCurRow = SBSTARTROW
  176.         iMaxRow = iCurRow
  177.         oCell = oSheet.getCellByPosition(SBDATECOLUMN, iCurRow)
  178.         oCell.Value = fDate
  179.     End If
  180.     sNewSheetName = sName
  181.     oLinkSheet = oSheets.GetByName("Link")
  182.     oSheet = oSheets.getByName(sName)
  183.     iLastRow = GetLastUsedRow(oSheet)- 2
  184.     iLastLinkRow = GetLastUsedRow(oLinkSheet)
  185.     iCurRow = iLastRow
  186.     bLeaveLoop = False
  187.     RemoveCount = 0
  188.     ' Delete all Cells in Date Area
  189.     Do
  190.         oCell = oSheet.GetCellbyPosition(SBDATECOLUMN,iCurRow)
  191.         If oCell.CellStyle = sColumnHeader Then
  192.             bLeaveLoop = True
  193.             StartIndex = iCurRow
  194.             iCurRow = iCurRow + 1
  195.         Else
  196.             RemoveCount = RemoveCount + 1
  197.             iCurRow = iCurRow - 1
  198.         End If
  199.     Loop Until bLeaveLoop    
  200.     If RemoveCount > 1 Then
  201.         oSheet.Rows.RemoveByIndex(iCurRow, RemoveCount-1)
  202.     End If
  203.     For i = 1 To iLastLinkRow
  204.         oCell = oSheet.GetCellbyPosition(SBDATECOLUMN,iCurRow)
  205.         iCellValue = oLinkSheet.GetCellByPosition(0,i).Value
  206.         If iCellValue > 0 Then
  207.             oCell.SetValue(oLinkSheet.GetCellByPosition(0,i).Value)
  208.         Else
  209.             oCell.SetValue(StringToDate(oLinkSheet.GetCellByPosition(0,i).String)
  210.         End If
  211.         oCell = oSheet.GetCellbyPosition(SBVALUECOLUMN,iCurRow)
  212.         oCell.SetValue(oLinkSheet.GetCellByPosition(4,i).Value)
  213.         If i < iLastLinkRow Then
  214.             iCurRow = iCurRow + 1
  215.             oSheet.Rows.InsertByIndex(iCurRow,1)
  216.         End If
  217.     Next i
  218.     iMaxRow = iCurRow
  219. End Sub
  220.  
  221.  
  222. Function StringToDate(DateString as String) as Date
  223. Dim ShortMonths(11)
  224. Dim DateList() as String
  225. Dim MaxIndex as Integer
  226. Dim i as Integer
  227.     ShortMonths(0) = "Jan"
  228.     ShortMonths(1) = "Feb"
  229.     ShortMonths(2) = "Mar"
  230.     ShortMonths(3) = "Apr"
  231.     ShortMonths(4) = "May"
  232.     ShortMonths(5) = "Jun"
  233.     ShortMonths(6) = "Jul"
  234.     ShortMonths(7) = "Aug"
  235.     ShortMonths(8) = "Sep"
  236.     ShortMonths(9) = "Oct"
  237.     ShortMonths(10) = "Nov"
  238.     ShortMonths(11) = "Dec"
  239.     For i = 0 To 11
  240.         DateString = ReplaceString(DateString,CStr(i+1),ShortMonths(i))
  241.     Next i
  242.     DateString = ReplaceString(DateString, ".", "-")
  243.     StringToDate = CDate(DateString)    
  244. End Function
  245.  
  246.  
  247. Sub UpdateChart(sName As String)
  248. Dim oSheet As Object
  249. Dim oCell As Object, oCursor As Object
  250. Dim oChartRange As Object
  251. Dim oEmbeddedChart As Object, oCharts As Object
  252. Dim oChart As Object, oDiagram As Object
  253. Dim oYAxis As Object, oXAxis As Object
  254. Dim fMin As Double, fMax As Double
  255. Dim nDateFormat As Long
  256. Dim aPos As Variant
  257. Dim aSize As Variant
  258. Dim oContainerChart as Object
  259. Dim mRangeAddresses(0) as New com.sun.star.table.CellRangeAddress
  260.     mRangeAddresses(0).Sheet = GetSheetIndex(oSheets, sNewSheetName)
  261.     mRangeAddresses(0).StartColumn = SBDATECOLUMN 
  262.     mRangeAddresses(0).StartRow = SBSTARTROW-1
  263.     mRangeAddresses(0).EndColumn = SBVALUECOLUMN
  264.     mRangeAddresses(0).EndRow = iMaxRow
  265.         
  266.     oSheet = oDocument.Sheets.getByName(sNewSheetName)
  267.     oCharts = oSheet.Charts
  268.     
  269.     If Not oCharts.hasElements Then
  270.         oSheet.GetCellbyPosition(2,2).SetString(sName)
  271.         oChartRange = oSheet.getCellRangeByPosition(SBDATECOLUMN,6,5,SBSTARTROW-3)
  272.         aPos = oChartRange.Position
  273.         aSize = oChartRange.Size
  274.         
  275.         Dim oRectangleShape As New com.sun.star.awt.Rectangle
  276.         oRectangleShape.X = aPos.X
  277.         oRectangleShape.Y = aPos.Y
  278.         oRectangleShape.Width = aSize.Width
  279.         oRectangleShape.Height = aSize.Height
  280.         oCharts.addNewByName(sName, oRectangleShape, mRangeAddresses(), True, False)
  281.         oContainerChart = oCharts.getByName(sName)
  282.         oChart = oContainerChart.EmbeddedObject
  283.         oChart.Title.String    = ""
  284.         oChart.HasLegend = False
  285.         oChart.diagram = oChart.createInstance("com.sun.star.chart.XYDiagram")
  286.         oDiagram = oChart.Diagram
  287.         oDiagram.DataRowSource = com.sun.star.chart.ChartDataRowSource.COLUMNS
  288.         oChart.Area.LineStyle = com.sun.star.drawing.LineStyle.SOLID
  289.         oXAxis = oDiagram.XAxis
  290.         oXAxis.TextBreak = False
  291.         nDateFormat = oXAxis.NumberFormats.getStandardFormat(com.sun.star.util.NumberFormat.DATE, oDocLocale)
  292.  
  293.         oYAxis = oDiagram.getYAxis()
  294.         oYAxis.AutoOrigin = True
  295.     Else
  296.         oChart = oCharts(0)
  297.         oChart.Ranges = mRangeAddresses()
  298.         oChart.HasRowHeaders = False
  299.         oEmbeddedChart = oChart.EmbeddedObject
  300.         oDiagram = oEmbeddedChart.Diagram
  301.         oXAxis = oDiagram.XAxis
  302.     End If
  303.     oXAxis.AutoStepMain = False
  304.     oXAxis.AutoStepHelp = False
  305.     oXAxis.StepMain = iStep
  306.     oXAxis.StepHelp = iStep
  307.     fMin = oSheet.getCellByPosition(SBDATECOLUMN,SBSTARTROW).Value
  308.     fMax = oSheet.getCellByPosition(SBDATECOLUMN,iMaxRow).Value
  309.     oXAxis.Min = fMin
  310.     oXAxis.Max = fMax
  311.     oXAxis.AutoMin = False
  312.     oXAxis.AutoMax = False
  313. End Sub
  314.  
  315.  
  316. Sub CalculateChartafterSplit(SheetName, NewNumber, OldNumber, NoteText, SplitDate)
  317. Dim oSheet as Object
  318. Dim i as Integer
  319. Dim oValueCell as Object
  320. Dim oDateCell as Object
  321. Dim bLeaveLoop as Boolean
  322.     If oSheets.HasbyName(SheetName) Then
  323.         oSheet = oSheets.GetbyName(SheetName)
  324.         i = 0
  325.         bLeaveLoop = False
  326.         Do
  327.             oValueCell = oSheet.GetCellbyPosition(SBVALUECOLUMN, SBSTARTROW + i)
  328.             If oValueCell.CellStyle = CurrCellStyle Then
  329.                 SplitCellValue(oSheet, OldNumber, NewNumber, SBVALUECOLUMN, SBSTARTROW + i, "")        
  330.                 i = i + 1
  331.             Else
  332.                 bLeaveLoop = True
  333.             End If
  334.         Loop Until bLeaveLoop
  335.         oDateCell = oSheet.GetCellbyPosition(SBDATECOLUMN, SBSTARTROW + i-1)
  336.         oDateCell.Annotation.SetString(NoteText)
  337.     End If
  338. End Sub
  339. </script:module>